home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / DOCDEMOS.PAK / COLLECT4.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  5KB  |  208 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. { Create a collection of graphical objects: Points, Circles,
  10.   and Rectangles. Use the ForEach iterator to display each
  11.   object in the collection. }
  12.  
  13. program Collect4;
  14.  
  15. uses
  16.   WObjects, WinTypes, WinProcs;
  17.  
  18. const
  19.   NumToDraw = 10;
  20.  
  21. { ********************************** }
  22. { ******  Graphical Objects  ******* }
  23. { ********************************** }
  24.  
  25. type
  26.   PGraphObject = ^TGraphObject;
  27.   TGraphObject = object(TObject)
  28.     Rect: TRect;
  29.     constructor Init(Bounds: TRect);
  30.     procedure Draw(DC: HDC); virtual;
  31.   end;
  32.  
  33.   PGraphEllipse = ^TGraphEllipse;
  34.   TGraphEllipse = object(TGraphObject)
  35.     procedure Draw(DC: HDC); virtual;
  36.   end;
  37.  
  38.   PGraphRect = ^TGraphRect;
  39.   TGraphRect = object(TGraphObject)
  40.     procedure Draw(DC: HDC); virtual;
  41.   end;
  42.  
  43.   PGraphPie = ^TGraphPie;
  44.   TGraphPie = object(TGraphObject)
  45.     ArcStart, ArcEnd: TPoint;
  46.     constructor Init(Bounds: TRect);
  47.     procedure Draw(DC: HDC); virtual;
  48.   end;
  49.  
  50. { TGraphObject }
  51. constructor TGraphObject.Init(Bounds: TRect);
  52. var
  53.   Height, Width: Word;
  54. begin
  55.   TObject.Init;
  56.   with Bounds do
  57.   begin
  58.     Height := Random(Bottom - Top) div 2 + 10;
  59.     Width := Random(Right - Left) div 3 + 15;
  60.   end;
  61.   with Rect do
  62.   begin
  63.     Left := Random(Bounds.Right - Bounds.Left - Width);
  64.     Right := Left + Width;
  65.     Top := Random(Bounds.Bottom - Bounds.Top - Height);
  66.     Bottom := Top + Height;
  67.   end;
  68. end;
  69.  
  70. procedure TGraphObject.Draw(DC: HDC);
  71. begin
  72.   Abstract;
  73. end;
  74.  
  75. { TGraphEllipse }
  76. procedure TGraphEllipse.Draw(DC: HDC);
  77. begin
  78.   with Rect do
  79.     Ellipse(DC, Left, Top, Right, Bottom);
  80. end;
  81.  
  82. { TGraphRect }
  83. procedure TGraphRect.Draw(DC: HDC);
  84. begin
  85.   with Rect do
  86.     Rectangle(DC, Left, Top, Right, Bottom);
  87. end;
  88.  
  89. { TGraphPie }
  90. constructor TGraphPie.Init(Bounds: TRect);
  91. var Height, Width: Word;
  92. begin
  93.   TGraphObject.Init(Bounds);
  94.   with Bounds do
  95.   begin
  96.     Height := Random(Bottom - Top);
  97.     Width := Random(Right - Left);
  98.  
  99.     ArcStart.X := Random(Right - Left - Width);
  100.     ArcEnd.X := ArcStart.X + Width;
  101.     ArcStart.Y := Random(Bottom - Top - Height);
  102.     ArcEnd.Y := ArcStart.Y + Height;
  103.   end;
  104. end;
  105.  
  106. procedure TGraphPie.Draw;
  107. begin
  108.   with Rect do
  109.     Pie(DC, Left, Top, Right, Bottom, ArcStart.X, ArcStart.Y, ArcEnd.X, ArcEnd.Y);
  110. end;
  111.  
  112. { ********************************** }
  113. { *********  Graph Window  ********* }
  114. { ********************************** }
  115. type
  116.   { Define a TApplication descendant }
  117.   TGraphApp = object(TApplication)
  118.     procedure InitMainWindow; virtual;
  119.   end;
  120.  
  121.   PGraphWindow = ^TGraphWindow;
  122.   TGraphWindow = object(TWindow)
  123.     GraphicsList: PCollection;
  124.     destructor Done; virtual;
  125.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  126.     procedure SetupWindow; virtual;
  127.   end;
  128.  
  129.  
  130. { TGraphApp }
  131. procedure TGraphApp.InitMainWindow;
  132. begin
  133.   MainWindow := New(PGraphWindow,
  134.     Init(nil, 'Collection of Graphical Objects'));
  135. end;
  136.  
  137. { TGraphWindow }
  138. procedure TGraphWindow.SetupWindow;
  139. var
  140.   Bounds: TRect;
  141.   I: Integer;
  142.   P: PGraphObject;
  143. begin
  144.   TWindow.SetupWindow;
  145.   GetClientRect(HWindow, Bounds);
  146.  
  147.   { Instantiate a collection of objects }
  148.  
  149.   { Initialize collection to hold 10 elements first, then grow by 5's }
  150.   GraphicsList := New(PCollection, Init(10, 5));
  151.  
  152.   for I := 1 to NumToDraw do
  153.   begin
  154.     case I mod 3 of                      { Create it }
  155.       0: P := New(PGraphRect, Init(Bounds));
  156.       1: P := New(PGraphEllipse, Init(Bounds));
  157.       0..2: P := New(PGraphPie, Init(Bounds));
  158.     end;
  159.     GraphicsList^.Insert(P);                     { Add it to collection }
  160.   end;
  161. end;
  162.  
  163. destructor TGraphWindow.Done;
  164. begin
  165.   Dispose(GraphicsList, Done);         { Delete collection }
  166.   TWindow.Done;
  167. end;
  168.  
  169. procedure TGraphWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  170.  
  171. { Nest the iterator method inside Paint so it can access the DC }
  172. procedure DrawAll(C: PCollection); far;
  173.  
  174. { Nested, far procedure. Receives one
  175.   collection element--a GraphObject, and
  176.   calls that elements Draw method.
  177. }
  178.  
  179. procedure CallDraw(P : PGraphObject); far;
  180. begin
  181.   P^.Draw(PaintDC);                            { Call Draw method }
  182. end;
  183.  
  184. begin { DrawAll }
  185.   C^.ForEach(@CallDraw);              { Draw each object }
  186. end;
  187.  
  188. begin
  189.   if GraphicsList <> nil then DrawAll(GraphicsList);
  190. end;
  191.  
  192.  
  193. { ********************************** }
  194. { **********  Main Program ********* }
  195. { ********************************** }
  196.  
  197. { Declare a variable of type TGraphApp }
  198. var
  199.   GraphApp: TGraphApp;
  200.  
  201. { Run the GraphApp }
  202. begin
  203.   GraphApp.Init('GraphApp');
  204.   GraphApp.Run;
  205.   GraphApp.Done;
  206. end.
  207.  
  208.